perm filename FIX.SAI[88,ALS] blob
sn#044835 filedate 1973-05-29 generic text, type T, neo UTF8
00100 BEGIN "FIX"
00200 DEFINE ⊂="COMMENT"; ⊂ 6/29/72;
00300 ⊂ This is a fast version of LIS.SAI which creates condensed files .D64 ;
00400 REQUIRE "COMSUB.HDR[1,THO]" SOURCE_FILE;
00510
00540
00600
00700 REQUIRE "FPREPAR[88,THO]" LOAD_MODULE;
00800 ⊂ REQUIRE "FFT8X[1,THO]" LOAD_MODULE;
00900 ⊂ EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;⊂ REFERENCE REAL X,Y);
00910
00920
00940
00950
01000 FORTRAN REAL PROCEDURE SQRT(REAL X);
01100 FORTRAN REAL PROCEDURE ALOG10(REAL X);
01200 FORTRAN REAL PROCEDURE COS(REAL X);
01300 FORTRAN REAL PROCEDURE SIN(REAL X);
01400 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
01500
01600 EXTERNAL PROCEDURE PREPARE;
01700 ⊂ EXTERNAL PROCEDURE SETBR;
01800 ⊂ EXTERNAL REAL PROCEDURE RUNTIM;
01900 EXTERNAL STRING PROCEDURE INCHWL;
02000
02100 DEFINE BPS="12";
02200 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",INSIZ="24";
02300 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
02400 DEFINE LBYT="ILDB(LBPT)";
02500 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
02700
02800 STRING FILEL,FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
02900 ⊂ INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
03000 INTERNAL INTEGER ARRAY LIST[0:INSIZ];
03100 ⊂ INTEGER ARRAY INDATA[0:640];
03200 INTEGER ARRAY LFILE[0:'177];
03300 INTERNAL REAL ARRAY C[0:256];
03400 INTERNAL REAL X,SX;
03500 REAL ARRAY WINDOW[0:256];
03600 INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
03700 INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
03800 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
03900 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
04000 INTEGER H,I,J,K,L,ZZ;
04100 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
04200 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
04300 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
04400 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
04500 ILPB,ILPC, IHPB,IHPC ;
04600 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
04700 INTERNAL INTEGER TFLAG;
04800 INTERNAL INTEGER ZEROF,ZEROC;
04900 INTERNAL REAL R0 ;
05000 INTERNAL INTEGER NP,NZ,FP1,FP2,FZ ; INTERNAL REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
05100 INTERNAL INTEGER ARRAY FF[1:5] ; INTERNAL REAL ARRAY AMP[1:5] ;
05200 LABEL START;
05300 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
05400 INTEGER HINCNT,HCOUNT,HINDEX;
05500
05600
05700 COMMENT MACROS;
05800 DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
05900 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
06000 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
06100 DEFINE TIL="STEP 1 UNTIL";
06200 DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
06300 INTEGER K.,J.; ⊂ USED IN MACROS;
06400 DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
06500 DEFINE ISQRT(I)="(K.←(I)↑0.5)";
06600 DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
06700 DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
06800 DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
06900 DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
07000 DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
07100 DEFINE FTRACE(N)=
07200 "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
07300 OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
07400 DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
07500 DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
07600 DEFINE PI="3.141592653",PICON="(PI/180)";
07700 DEFINE INFINITY="'377777777777";
07800 STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
07900
08000
08100
08200
08300 STRING PROCEDURE HEADER;
08400 BEGIN STRING H1,H2; INTEGER I,J,K;
08500 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
08600 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
08700 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
08800
08900 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
09000 IF J ≥ 0 THEN BEGIN "LATCH"
09100 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
09200 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
09300 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
09400 HCOUNT←HCOUNT-J;
09500 HINDEX←HINDEX+1; RETURN(PREHINT); DONE
09600 END
09700 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
09800 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
09900 END;
10000 END "LATCH";
10100 PREHINT←""; RETURN(PREHINT); END "XX";
10200 END "HEADER";
10300
10400
10500 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
10600 BEGIN
10700 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
10800 COMPLEX TRANSFORM ;
10900 INTEGER K,NK,NH;
11000 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
11100 NH←N%2; R←3.1415926536/N;
11200 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
11300 DC←-0.5*R; CK←1.0; SK←0;
11400 IF EVALUATE THEN
11500 BEGIN
11600 CK←-1.0; DC←-DC;
11700 END
11800 ELSE
11900 BEGIN
12000 A[N]←A[0]; B[N]←B[0];
12100 END;
12200 FOR K←0 STEP 1 UNTIL NH DO
12300 BEGIN
12400 NK←N-K;
12500 AA←A[K]+A[NK]; AB←A[K]-A[NK];
12600 BA←B[K]+B[NK]; BB←B[K]-B[NK];
12700 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
12800 B[NK]←IM-BB; B[K]←IM+BB;
12900 A[NK]←AA-RE; A[K]←AA+RE;
13000 DC←R*CK+DC; CK←CK+DC;
13100 DS←R*SK+DS; SK←SK+DS;
13200 END;
13300 END "XRTRAN";
13400
00100 SETBR;
00200
00300
00600 UPCNT←3;
00700 FILEL←"LIST1";
00800 FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00900 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
01000
01100 IF (TFILEI←STRINGIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
01200 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
01300 LOOKIN(CHAN5,FILEL); EOFA←0;
01400
01500 M←8;
01600 N←2↑M; NF←2*N;
01700 FOR I←0 STEP 1 UNTIL N DO
01800 WINDOW[I]←(1-COS((2*PI*I)/N))/2;
02900 N←2↑M;
03000 OUTSTR(CRLF&"DATSHIFT HAS BEEN SET = 0");
03100 DATSHIFT←0;
03200 OUTSTR(CRLF);
03300
03400 START:
03500 WHILE EOFA=0 DO BEGIN "LISTREAD" INTEGER FFTCNT; REAL ARRAY FFTBUF[1:1290];
03600 HINDEX←21; HCOUNT←HINCNT←0; OPT1←"Y"; OPT2←"N"; STEPX←"Y";
03700 FILEI←INPUT(CHAN5,1);
04600
04700 CLOSE(CHAN4);
04800 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
04900 LOOKIN(CHAN4,FILEI);
05000 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
05100 EOF←0; SEGC←0; SEGCNT←0;
05200 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
05300
05400 IF RATE=0 THEN RATE←CVD(STRINGIN("Sampling rate missing. Rate = "));
05500 OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segments"&CRLF);
05600 ⊂ ****Create condensed files ;
06600 SETFORMAT(1,0);
06610
06620
06630 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,4,0,0,0);TFILE←"";
06640 FOR I←0 STEP 1 UNTIL 9 DO BEGIN
06650 TFILEI←FILEI[1 TO 1];
06660 IF TFILEI="." THEN DONE;
06670 TFILE←TFILE&TFILEI;
06680 FILEI←FILEI[2 TO 9];
06690 END;
06700 SETFORMAT(1,0);OPEN(8,"DSK",'10,2,0,0,0,0);LOOKUP(8,TFILE&".T0[77,THO]",0);
06705 ARRYIN(8,LFILE[0],'200); RELEASE(8);
06710 TFILE←TFILE&".T0[77,THO]");
06720 OUTSTR(CRLF&"TFILE= "&TFILE&CRLF);
06730 ENTER(CHAN2,TFILE,0);
06740 ARRYOUT(CHAN2,LFILE[0],'200); ⊂ COPY HEADER INFO;
07100 BEGIN "FFT" INTEGER ARRAY INDATA[0:SEGTOT*4];
07105 ⊂ **** SET PARAMETER RANGES
07110 THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
07115 NP=800/1500 NZRNG=NP+/-500 ?
07120 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
07125 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
07130 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
07135 I3L←1950./SX; I3H←3250./SX+.5;
07140 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
07145 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
07150 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
07300
07310
07320
07330 FOR I←0 STEP 1 UNTIL SEGTOT*4 DO INDATA[I]←0;
07340
07350
07360 SEGC←0;
07400 K←1; WHILE EOF=0 DO BEGIN "LP"
07500 ARRYIN(4,FFTBUF[1],1290); OUTSTR(CVS(K)&TB);
07600 IF EOF≠0 THEN FOR I←(EOF LAND '777777)+1 STEP 1 UNTIL 1290
07700 DO FFTBUF[I]←0.;
07800
07900 FOR I←0 STEP 1 UNTIL 9 DO BEGIN
08000 FOR J←0 STEP 1 UNTIL N/2 DO C[J]←FFTBUF[129*I+J+1];
08010
08020
08030 IF (C[0]≠0) THEN PREPARE ELSE
08035 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←0;
08040 SEGC←SEGC+1; J←(SEGC-1)*4; L←0; IF SEGC>SEGTOT THEN DONE;
08100 FOR P←0 STEP 1 UNTIL 23 DO BEGIN
08110 IF INDAT[P]<0 THEN INDAT[P]←0 ELSE IF INDAT[P]>63 THEN INDAT[P]←63;
08120 H←(H LSH 6)+INDAT[P]; IF L<5 THEN L←L+1 ELSE BEGIN
08130 INDATA[J]←H; L←0; J←J+1; END;
08140 END; ⊂ ENDS P 0 TO 23 LOOP;
08150
08160 END; ⊂ ENDS I 0 TO 9 LOOP;
08170
08180
08190
08200
08300 K←K+1; IF EOF≠0 THEN DONE; END "LP";
08400
08500
08600
08700
08800 ARRYOUT(CHAN2,INDATA[0],SEGTOT*4);
08900 CLOSE(CHAN2);
13000 END "FFT";
13200 OUTSTR(TFILE&" has been written."&CRLF);
13300 IF EOFA≠0 THEN DONE;
13400 END "LISTREAD";
13500 GO TO START;
13600 END "FIX";